home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2002 March
/
Chip_2002-03_cd1.bin
/
zkuste
/
delphi
/
kolekce
/
d3456
/
gmprintsuite_eval.exe
/
{app}
/
GmObjects.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2002-01-02
|
35KB
|
1,174 lines
unit GmObjects;
interface
uses Windows, GmStream, Classes, Graphics, GmTypes;
type
TGmBaseObject = class(TObject)
private
FShapeID: integer;
FX: Integer;
FY: Integer;
FPreviewPage: integer;
public
constructor Create;
destructor Destroy; override;
procedure SaveToStream(AStream: TStream); virtual;
procedure LoadFromStream(AStream: TStream); virtual;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); virtual; abstract; //; Ppi: integer; Offset: TPoint; FPreview: TComponent); virtual; abstract;
// properties...
property X: Integer read FX write FX;
property Y: Integer read FY write FY;
property ShapeID: integer read FShapeID;
property Page: integer read FPreviewPage write FPreviewPage;
end;
TGmGraphicObject = class (TGmBaseObject)
private
FCopyMode: TCopyMode;
FDrawAsBitmap: Boolean;
FX2: Integer;
FY2: Integer;
FBitmapStream: TMemoryStream;
FMetaFile: TMetaFile;
FType: TGmGraphicType;
function GetBitmap: TBitmap;
procedure SetBitmap(ABitmap: TBitmap);
public
constructor Create;
destructor Destroy; override;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
procedure SaveToStream(AStream: TStream); override;
procedure LoadFromStream(AStream: TStream); override;
procedure SetBounds(aX1, aY1, aX2, aY2: Extended);
property CopyMode: TCopyMode read FCopyMode write FCopyMode;
property X2: Integer read FX2 write FX2;
property Y2: Integer read FY2 write FY2;
property DrawAsBitmap: Boolean read FDrawAsBitmap write FDrawAsBitmap;
property Bitmap: TBitmap read GetBitmap write SetBitmap;
property Metafile: TMetafile read FMetafile write FMetafile;
property AType: TGmGraphicType read FType write FType;
end;
// *** TGmLineObject ***
TGmLineType = (GmLine, GmLineExt);
TGmLineObject = class(TGmBaseObject)
private
FPen: TGmPen;
FX2 : Integer;
FY2 : Integer;
FLineType: TGmLineType;
public
constructor Create;
procedure LoadFromStream(AStream: TStream); override;
procedure SaveToStream(AStream: TStream); override;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
//procedure SetBounds(aX1, aY1, aX2, aY2: Extended);
property X2: Integer read FX2 write FX2;
property Y2: Integer read FY2 write FY2;
property Pen: TGmPen read FPen write FPen;
property LineType: TGmLineType read FLineType write FLineType default GmLine;
end;
TGmTextObject = class(TGmBaseObject)
private
FBrush: TGmBrush;
FCaption: string;
FFont: TGmFont;
public
constructor Create;
procedure SaveToStream(AStream: TStream); override;
procedure LoadFromStream(AStream: TStream); override;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
// properties...
property Brush: TGmBrush read FBrush write FBrush;
property Caption: string read FCaption write FCaption;
property Font: TGmFont read FFont write FFont;
end;
// *** TGmTextBoxObject ***
TGmTextBoxObject = class(TGmTextObject)
private
FAlignment: TAlignment;
FVertAlignment: byte;
FX2: Integer;
FY2: Integer;
FPen: TGmPen;
public
constructor Create;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
procedure SaveToStream(AStream: TStream); override;
procedure LoadFromStream(AStream: TStream); override;
//procedure SetBounds(Left, Top, Right, Bottom: Integer);
property Alignment: TAlignment read FAlignment write FAlignment;
property VertAlignment: byte read FVertAlignment write FVertAlignment;
property X2: Integer read FX2 write FX2;
property Y2: Integer read FY2 write FY2;
property Pen: TGmPen read FPen write FPen;
end;
TGmSimpleShape = class(TGmBaseObject)
private
FBrush: TGmBrush;
FPen: TGmPen;
FX2, FY2: integer;
public
procedure SaveToStream(AStream: TStream); override;
procedure LoadFromStream(AStream: TStream); override;
// properties...
property Brush: TGmBrush read FBrush write FBrush;
property Pen: TGmPen read FPen write FPen;
property X2: integer read FX2 write FX2;
property Y2: integer read FY2 write FY2;
end;
TGmEllipseShape = class(TGmSimpleShape)
public
constructor Create;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
end;
TGmRectangleShape = class(TGmSimpleShape)
public
RectType: TGmRectType;
constructor Create;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
end;
TGmRoundRectShape = class(TGmSimpleShape)
private
FX3: Integer;
FY3: Integer;
public
constructor Create;
procedure SaveToStream(AStream: TStream); override;
procedure LoadFromStream(AStream: TStream); override;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
property X3: Integer read FX3 write FX3;
property Y3: Integer read FY3 write FY3;
end;
TGmComplexShape = class(TGmSimpleShape)
private
FX3: Integer;
FY3: Integer;
FX4: Integer;
FY4: Integer;
public
procedure LoadFromStream(AStream: TStream); override;
procedure SaveToStream(AStream: TStream); override;
//procedure SetBounds(aX1, aY1, aX2, aY2, aX3, aY3, aX4, aY4: Extended);
// properties...
property X3: Integer read FX3 write FX3;
property Y3: Integer read FY3 write FY3;
property X4: Integer read FX4 write FX4;
property Y4: Integer read FY4 write FY4;
end;
TGmArcShape = class(TGmComplexShape)
public
constructor Create;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
end;
TGmChordShape = class(TGmComplexShape)
public
constructor Create;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
end;
TGmPieShape = class(TGmComplexShape)
public
constructor Create;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
end;
{$IFNDEF VER100}
TGmPolyBaseObject = class(TGmBaseObject)
private
FBrush: TGmBrush;
FPen: TGmPen;
public
Points: array of TPoint;
procedure SaveToStream(AStream: TStream); override;
procedure LoadFromStream(AStream: TStream); override;
property Pen: TGmPen read FPen write FPen;
property Brush: TGmBrush read FBrush write FBrush;
end;
TGmPolygonObject = class(TGmPolyBaseObject)
public
constructor Create;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
end;
TGmPolyLineObject = class(TGmPolyBaseObject)
public
constructor Create;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
end;
TGmPolyBezierObject = class(TGmPolyBaseObject)
public
constructor Create;
procedure Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended); override;
end;
{$ENDIF}
// *** Global Functions ***
function BrushToGmBrush(ABrush: TBrush): TGmBrush;
function FontToGmFont(AFont: TFont): TGmFont;
function PenToGmPen(APen: TPen): TGmPen;
procedure GmBrushToBrush(ABrush: TBrush; AGmBrush: TGmBrush);
procedure GmFontToFont(AFont: TFont; AGmFont: TGmFont; Scale: Extended);
procedure GmPenToPen(APen: TPen; AGmPen: TGmPen);
implementation
uses GmConst, GmPreview;
//------------------------------------------------------------------------------
// *** Global functions ***
function BrushToGmBrush(ABrush: TBrush): TGmBrush;
begin
Result.Color := ABrush.Color;
Result.Style := ABrush.Style;
end;
function FontToGmFont(AFont: TFont): TGmFont;
var
logRec : TLogFont;
begin
GetObject(AFont.Handle, SizeOf(TLogFont), @logrec);
Result.Angle := logrec.lfEscapement / 10;
Result.Color := AFont.Color;
Result.Name := AFont.Name;
Result.Size := AFont.Size;
Result.Style := AFont.Style;
end;
function PenToGmPen(APen: TPen): TGmPen;
begin
Result.Color := APen.Color;
Result.Style := APen.Style;
Result.Width := APen.Width;
Result.Mode := APen.mode;
end;
procedure GmBrushToBrush(ABrush: TBrush; AGmBrush: TGmBrush);
begin
ABrush.Color := AGmBrush.Color;
ABrush.Style := AGmBrush.Style;
end;
procedure GmFontToFont(AFont: TFont; AGmFont: TGmFont; Scale: Extended);
var
logRec : TLogFont;
begin
AFont.Color := AGmFont.Color;
AFont.Name := AGmFont.Name;
AFont.Size := AGmFont.Size;
AFont.Style := AGmFont.Style;
AFont.Height := Round(Scale * AFont.Height);
GetObject(AFont.Handle, SizeOf(TLogFont), @logrec);
logrec.lfEscapement := Round(AGmFont.Angle*10);
AFont.Handle := CreateFontIndirect(logRec);
end;
procedure GmPenToPen(APen: TPen; AGmPen: TGmPen);
begin
APen.Color := AGmPen.Color;
APen.Style := AGmPen.Style;
APen.Width := AGmPen.Width;
APen.Mode := AGmPen.Mode;
end;
function PixelsPerInch(ACanvas: TCanvas): integer;
begin
Result := GetDeviceCaps(ACanvas.Handle, LOGPIXELSX);
end;
//------------------------------------------------------------------------------
// *** TGmBaseObject ***
constructor TGmBaseObject.Create;
begin
inherited Create;
end;
destructor TGmBaseObject.Destroy;
begin
inherited Destroy;
end;
procedure TGmBaseObject.SaveToStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
AStream.WriteBuffer(FShapeID, SizeOf(FShapeID));
GmStream := TGmExtStream.Create;
try
GmStream.WriteInteger(FX);
GmStream.WriteInteger(FY);
finally
GmStream.SaveToStream(AStream);
GmStream.Free;
end;
end;
procedure TGmBaseObject.LoadFromStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
GmStream := TGmExtStream.Create;
try
GmStream.LoadFromStream(AStream);
FX := GmStream.ReadInteger;
FY := GmStream.ReadInteger;
finally
GmStream.Free;
end;
end;
//------------------------------------------------------------------------------
// *** TGmGraphicObject ***
constructor TGmGraphicObject.Create;
begin
inherited Create;
FShapeID := GM_GRAPHIC_ID;
FDrawAsBitmap := False;
FBitmapStream := TMemoryStream.Create;
end;
destructor TGmGraphicObject.Destroy;
begin
if Assigned(FBitmapStream) then FBitmapStream.Free;
if Assigned(FMetafile) then FMetafile.Free;
inherited;
end;
function TGmGraphicObject.GetBitmap: TBitmap;
begin
Result := TBitmap.Create;
if FBitmapStream.Size > 0 then
begin
FBitmapStream.Seek(0, soFromBeginning);
Result.LoadFromStream(FBitmapStream);
end
end;
procedure TGmGraphicObject.SetBitmap(ABitmap: TBitmap);
begin
FBitmapStream.Clear;
ABitmap.SaveToStream(FBitmapStream);
FType := gtBitmap;
end;
procedure TGmGraphicObject.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
var
BitmapHeader: pBitmapInfo;
BitmapImage : POINTER;
HeaderSize : DWORD; // Use DWORD for D3-D5 compatibility
ImageSize : DWORD;
CM : LongInt;
begin
CM := 0;
case FCopyMode of
cmBlackness: CM := BLACKNESS;
cmDstInvert: CM := DSTINVERT;
cmMergeCopy: CM := MERGECOPY;
cmMergePaint: CM := MERGEPAINT;
cmNotSrcCopy: CM := NOTSRCCOPY;
cmNotSrcErase:CM := NOTSRCERASE;
cmPatCopy: CM := PATCOPY;
cmPatInvert: CM := PATINVERT;
cmPatPaint: CM := PATPAINT;
cmSrcAnd: CM := SRCAND;
cmSrcCopy: CM := SRCCOPY;
cmSrcErase: CM := SRCERASE;
cmSrcInvert: CM := SRCINVERT;
cmSrcPaint: CM := SRCPAINT;
cmWhiteness: CM := WHITENESS;
end;
GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
GetMem(BitmapHeader, HeaderSize);
GetMem(BitmapImage, ImageSize);
try
GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top, // Destination Origin
DestRect.Right - DestRect.Left, // Destination Width
DestRect.Bottom - DestRect.Top, // Destination Height
0, 0, // Source Origin
Bitmap.Width, Bitmap.Height, // Source Width & Height
BitmapImage,
TBitmapInfo(BitmapHeader^),
DIB_RGB_COLORS,
CM)
finally
FreeMem(BitmapHeader);
FreeMem(BitmapImage)
end;
end; {PrintBitmap}
var
DestRect: TRect;
CanvasPpi: integer;
ABitmap: TBitmap;
LastCopyMode: TCopyMode;
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
DestRect := Rect((0-Offset.X) + Round(CanvasPpi * ConvertValue(FX, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX2, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY2, GmUnits, GmInches)));
LastCopyMode := ACanvas.CopyMode;
ACanvas.CopyMode := FCopyMode;
try
case FType of
gtBitmap :
begin
if TGmPreview(APreview).GmPrinter.Printing then
PrintBitmap(ACanvas, DestRect, GetBitmap)
else
ACanvas.StretchDraw(DestRect, GetBitmap);
end;
gtMetafile:
begin
if (FDrawAsBitmap) and (TGmPreview(APreview).GmPrinter.Printing) then
begin
ABitmap := TBitmap.Create;
ABitmap.Width := (DestRect.Right - DestRect.Left);
ABitmap.Height := (DestRect.Bottom - DestRect.Top);
ABitmap.HandleType := bmDIB;
PlayEnhMetaFile(ABitmap.Canvas.Handle, FMetaFile.Handle, Rect(0,0,ABitmap.Width, ABitmap.Height));
PrintBitmap(ACanvas, DestRect, ABitmap);
ABitmap.Free;
end
else
PlayEnhMetaFile(ACanvas.Handle, FMetaFile.Handle, DestRect);
end;
end;
finally
ACanvas.CopyMode := LastCopyMode;
end;
end;
procedure TGmGraphicObject.LoadFromStream(AStream: TStream);
var
GmStream: TGmExtStream;
ABitmap: TBitmap;
begin
inherited LoadFromStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.LoadFromStream(AStream);
FX2 := GmStream.ReadInteger;
FY2 := GmStream.ReadInteger;
FDrawAsBitmap := GmStream.ReadBoolean;
FType := TGmGraphicType(GmStream.ReadInteger);
case FType of
gtMetafile:
begin
Metafile := TMetafile.Create;
Metafile.LoadFromStream(GmStream);
end;
gtBitmap :
begin
ABitmap := TBitmap.Create;
ABitmap.LoadFromStream(GmStream);
Bitmap := (ABitmap);
ABitmap.Free;
end;
end;
finally
GmStream.Free;
end;
end;
procedure TGmGraphicObject.SaveToStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited SaveToStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.WriteInteger(FX2);
GmStream.WriteInteger(FY2);
GmStream.WriteBoolean(FDrawAsBitmap);
GmStream.WriteInteger(Ord(FType));
case FType of
gtMetafile: Metafile.SaveToStream(GmStream);
gtBitmap : Bitmap.SaveToStream(GmStream);
end;
finally
GmStream.SaveToStream(AStream);
GmStream.Free;
end;
end;
procedure TGmGraphicObject.SetBounds(aX1, aY1, aX2, aY2: Extended);
begin
FX := Round(aX1);
FY := Round(aY1);
FX2 := Round(aX2);
FY2 := Round(aY2);
end;
//------------------------------------------------------------------------------
// *** TGmLineObject ***
constructor TGmLineObject.Create;
begin
inherited Create;
FShapeID := GM_LINE_ID;
FLineType:= GmLine;
end;
procedure TGmLineObject.LoadFromStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited LoadFromStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.LoadFromStream(AStream);
FPen := GmStream.ReadPen;
FX2 := GmStream.ReadInteger;
FY2 := GmStream.ReadInteger;
FLineType := TGmLineType(GmStream.ReadInteger);
finally
GmStream.Free;
end;
end;
procedure TGmLineObject.SaveToStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited SaveToStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.WritePen(FPen);
GmStream.WriteInteger(FX2);
GmStream.WriteInteger(FY2);
GmStream.WriteInteger(Ord(FLineType));
finally
GmStream.SaveToStream(AStream);
GmStream.Free;
end;
end;
procedure TGmLineObject.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
CanvasPpi: integer;
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
with ACanvas do
begin
GmPenToPen(Pen, FPen);
MoveTo((0-Offset.X) + Round(CanvasPpi * ConvertValue(FX, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY, GmUnits, GmInches)));
LineTo((0-Offset.X) + Round(CanvasPpi * ConvertValue(FX2, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY2, GmUnits, GmInches)));
end;
end;
//------------------------------------------------------------------------------
// *** TGmTextObject ***
constructor TGmTextObject.Create;
begin
inherited Create;
FShapeID := GM_TEXT_ID;
end;
procedure TGmTextObject.SaveToStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited SaveToStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.WriteBrush(FBrush);
GmStream.WriteStr(FCaption);
GmStream.WriteFont(FFont);
finally
GmStream.SaveToStream(AStream);
GmStream.Free;
end;
end;
procedure TGmTextObject.LoadFromStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited LoadFromStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.LoadFromStream(AStream);
FBrush := GmStream.ReadBrush;
FCaption := GmStream.ReadStr;
FFont := GmStream.ReadFont;
finally
GmStream.Free;
end;
end;
procedure TGmTextObject.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
Top, Left: integer;
Tokenized: string;
CanvasPpi: integer;
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
Tokenized := TGmPreview(APreview).Tokenize(FCaption, FPreviewPage);
Left := (0-Offset.X) + Round(CanvasPpi * ConvertValue(X, GmUnits, GmInches));
Top := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(Y, GmUnits, GmInches));
GmBrushToBrush(ACanvas.Brush, FBrush);
GmFontToFont(ACanvas.Font, FFont, Scale);
//ACanvas.Font.Height := Round(Scale*ACanvas.Font.Height);
ACanvas.TextOut(Left, Top, Tokenized);
end;
//------------------------------------------------------------------------------
constructor TGmTextBoxObject.Create;
begin
inherited Create;
FShapeID := GM_TEXTBOX_ID;
end;
procedure TGmTextBoxObject.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
DestRect: TRect;
Align: Byte;
VertAlign: Byte;
CanvasPpi: integer;
begin
Align := 0;
VertAlign := 0;
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
case FAlignment of
taLeftJustify : Align := DT_LEFT;
taCenter : Align := DT_CENTER;
taRightJustify: Align := DT_RIGHT;
end;
case FVertAlignment of
0 : VertAlign := DT_TOP;
1 : VertAlign := DT_VCENTER+DT_SINGLELINE;
2 : VertAlign := DT_BOTTOM+DT_SINGLELINE;
end;
with ACanvas do
begin
GmBrushToBrush(Brush, FBrush);
GmFontToFont(Font, FFont, Scale);
GmPenToPen(Pen, FPen);
// calculate the destination rectangle...
DestRect.Left := (0-Offset.X) + Round(CanvasPpi * ConvertValue(FX, GmUnits, GmInches));
DestRect.Top := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY, GmUnits, GmInches));
DestRect.Right := (0-Offset.X) + Round(CanvasPpi * ConvertValue(FX2, GmUnits, GmInches));
DestRect.Bottom := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY2, GmUnits, GmInches));
Rectangle(DestRect.Left, DestRect.Top, DestRect.Right, DestRect.Bottom);
Brush.Style := bsClear;
Windows.DrawText(Handle,
PChar(FCaption),
Length(FCaption),
DestRect,
DT_WORDBREAK+Align+VertAlign+DT_EXPANDTABS);
end;
end;
procedure TGmTextBoxObject.SaveToStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited SaveToStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.WriteInteger(Ord(FAlignment));
GmStream.WriteInteger(FX2);
GmStream.WriteInteger(FY2);
GmStream.WritePen(FPen);
finally
GmStream.SaveToStream(AStream);
GmStream.Free;
end;
end;
procedure TGmTextBoxObject.LoadFromStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited LoadFromStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.LoadFromStream(AStream);
FAlignment := TAlignment(GmStream.ReadInteger);
FX2 := GmStream.ReadInteger;
FY2 := GmStream.ReadInteger;
FPen := GmStream.ReadPen;
finally
GmStream.Free;
end;
end;
//------------------------------------------------------------------------------
// *** TGmSimpleShape ***
procedure TGmSimpleShape.SaveToStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited SaveToStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.WriteBrush(FBrush);
GmStream.WritePen(FPen);
GmStream.WriteInteger(FX2);
GmStream.WriteInteger(FY2);
finally
GmStream.SaveToStream(AStream);
GmStream.Free;
end;
end;
procedure TGmSimpleShape.LoadFromStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited LoadFromStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.LoadFromStream(AStream);
FBrush := GmStream.ReadBrush;
FPen := GmStream.ReadPen;
FX2 := GmStream.ReadInteger;
FY2 := GmStream.ReadInteger;
finally
GmStream.Free;
end;
end;
//------------------------------------------------------------------------------
// *** TGmRectangleShape ***
constructor TGmRectangleShape.Create;
begin
inherited Create;
FShapeID := GM_RECTANGLE_ID;
RectType := gmRectangle;
end;
procedure TGmRectangleShape.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
ARect: TRect;
CanvasPpi: integer;
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
ARect.Left := (0-Offset.X) + Round(CanvasPpi * ConvertValue(FX, GmUnits, GmInches));
ARect.Top := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY, GmUnits, GmInches));
ARect.Right := (0-Offset.X) + Round(CanvasPpi * ConvertValue(FX2, GmUnits, GmInches));
ARect.Bottom := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY2, GmUnits, GmInches));
GmBrushToBrush(ACanvas.Brush, FBrush);
GmPenToPen(ACanvas.Pen, FPen);
case RectType of
gmRectangle: ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
gmFillRect: ACanvas.FillRect(ARect);
end;
end;
//------------------------------------------------------------------------------
// *** TGmEllipseShape ***
constructor TGmEllipseShape.Create;
begin
inherited;
FShapeID := GM_ELLIPSE_ID;
end;
procedure TGmEllipseShape.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
ARect: TRect;
CanvasPpi: integer;
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
ARect.Left := (0-Offset.X) + Round(CanvasPpi * ConvertValue(FX, GmUnits, GmInches));
ARect.Top := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY, GmUnits, GmInches));
ARect.Right := (0-Offset.X) + Round(CanvasPpi * ConvertValue(FX2, GmUnits, GmInches));
ARect.Bottom := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY2, GmUnits, GmInches));
with ACanvas do
begin
GmPenToPen(Pen, FPen);
GmBrushToBrush(Brush, FBrush);
Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;
end;
//------------------------------------------------------------------------------
// *** TGmRoundRectShape ***
constructor TGmRoundRectShape.Create;
begin
inherited;
FShapeID := GM_ROUNDRECT_ID;
end;
procedure TGmRoundRectShape.SaveToStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited SaveToStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.WriteInteger(FX3);
GmStream.WriteInteger(FY3);
finally
GmStream.SaveToStream(AStream);
GmStream.Free;
end;
end;
procedure TGmRoundRectShape.LoadFromStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited LoadFromStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.LoadFromStream(AStream);
FX3 := GmStream.ReadInteger;
FY3 := GmStream.ReadInteger;
finally
GmStream.Free;
end;
end;
procedure TGmRoundRectShape.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
ARect: TRect;
_X3, _Y3: integer;
CanvasPpi: integer;
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
ARect.Left := (0-Offset.X) + Round(CanvasPpi * ConvertValue(FX, GmUnits, GmInches));
ARect.Top := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY, GmUnits, GmInches));
ARect.Right := (0-Offset.X) + Round(CanvasPpi * ConvertValue(FX2, GmUnits, GmInches));
ARect.Bottom := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY2, GmUnits, GmInches));
_X3 := (0-Offset.X) + Round(CanvasPpi * ConvertValue(FX3, GmUnits, GmInches));
_Y3 := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY3, GmUnits, GmInches));
with ACanvas do
begin
GmPenToPen(Pen, FPen);
GmBrushToBrush(Brush, FBrush);
RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, _X3, _Y3);
end;
end;
//------------------------------------------------------------------------------
// *** TGmComplexShape ***
procedure TGmComplexShape.LoadFromStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited LoadFromStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.LoadFromStream(AStream);
FX3 := GmStream.ReadInteger;
FY3 := GmStream.ReadInteger;
FX4 := GmStream.ReadInteger;
FY4 := GmStream.ReadInteger;
finally
GmStream.Free;
end;
end;
procedure TGmComplexShape.SaveToStream(AStream: TStream);
var
GmStream: TGmExtStream;
begin
inherited SaveToStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.WriteInteger(FX3);
GmStream.WriteInteger(FY3);
GmStream.WriteInteger(FX4);
GmStream.WriteInteger(FY4);
finally
GmStream.SaveToStream(AStream);
GmStream.Free;
end;
end;
//------------------------------------------------------------------------------
// *** TGmArcShape ***
constructor TGmArcShape.Create;
begin
inherited Create;
FShapeID := GM_ARC_ID;
end;
procedure TGmArcShape.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
CanvasPpi: integer;
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
with ACanvas do
begin
GmPenToPen(Pen, FPen);
GmBrushToBrush(Brush, FBrush);
Arc((0-Offset.X) + Round(CanvasPpi * ConvertValue(FX, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX2, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY2, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX3, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY3, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX4, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY4, GmUnits, GmInches)));
end;
end;
//------------------------------------------------------------------------------
// *** TGmChordShape ***
constructor TGmChordShape.Create;
begin
inherited Create;
FShapeID := GM_CHORD_ID;
end;
procedure TGmChordShape.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
CanvasPpi: integer;
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
with ACanvas do
begin
GmPenToPen(Pen, FPen);
GmBrushToBrush(Brush, FBrush);
Chord((0-Offset.X) + Round(CanvasPpi * ConvertValue(FX, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX2, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY2, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX3, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY3, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX4, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY4, GmUnits, GmInches)));
end;
end;
//------------------------------------------------------------------------------
// *** TGmPieShape ***
constructor TGmPieShape.Create;
begin
inherited Create;
FShapeID := GM_PIE_ID;
end;
procedure TGmPieShape.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
CanvasPpi: integer;
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
with ACanvas do
begin
GmPenToPen(Pen, FPen);
GmBrushToBrush(Brush, FBrush);
Pie((0-Offset.X) + Round(CanvasPpi * ConvertValue(FX, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX2, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY2, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX3, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY3, GmUnits, GmInches)),
(0-Offset.X) + Round(CanvasPpi * ConvertValue(FX4, GmUnits, GmInches)),
(0-Offset.Y) + Round(CanvasPpi * ConvertValue(FY4, GmUnits, GmInches)));
end;
end;
//------------------------------------------------------------------------------
{$IFNDEF VER100}
// *** TGmPolyBaseObject ***
procedure TGmPolyBaseObject.SaveToStream(AStream: TStream);
var
GmStream: TGmExtStream;
ICount: integer;
begin
inherited SaveToStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.WriteBrush(FBrush);
GmStream.WritePen(FPen);
GmStream.WriteInteger(High(Points));
for ICount := 0 to High(Points) do
begin
GmStream.WriteInteger(Points[ICount].X);
GmStream.WriteInteger(Points[ICount].Y);
end;
finally
GmStream.SaveToStream(AStream);
GmStream.Free;
end;
end;
procedure TGmPolyBaseObject.LoadFromStream(AStream: TStream);
var
GmStream: TGmExtStream;
ICount: integer;
begin
inherited LoadFromStream(AStream);
GmStream := TGmExtStream.Create;
try
GmStream.LoadFromStream(AStream);
FBrush := GmStream.ReadBrush;
FPen := GmStream.ReadPen;
SetLength(Points, GmStream.ReadInteger+1);
for ICount := 0 to High(Points) do
begin
Points[ICount].X := GmStream.ReadInteger;
Points[ICount].Y := GmStream.ReadInteger;
end;
finally
GmStream.Free;
end;
end;
//------------------------------------------------------------------------------
// *** TPolygonObject ***
constructor TGmPolygonObject.Create;
begin
inherited Create;
FShapeID := GM_POLYGON_ID;
end;
procedure TGmPolygonObject.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
count: integer;
CanvasPoints: array of TPoint;
CanvasPpi: integer;
begin
with ACanvas do
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
GmBrushToBrush(Brush, FBrush);
GmPenToPen(Pen, FPen);
SetLength(CanvasPoints, High(Points)+1);
for count := 0 to High(Points) do
begin
CanvasPoints[count].x := (0-Offset.X) + Round(CanvasPpi * ConvertValue(Points[count].x, GmUnits, GmInches)); //Round(Ppi * InchesX);
CanvasPoints[count].y := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(Points[count].y, GmUnits, GmInches)); // Round(Ppi * InchesY);
end;
Polygon(CanvasPoints);
end;
end;
//------------------------------------------------------------------------------
// *** TPolylineObject ***
constructor TGmPolyLineObject.Create;
begin
inherited Create;
FShapeID := GM_POLYLINE_ID;
end;
procedure TGmPolyLineObject.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
count: integer;
CanvasPoints: array of TPoint;
CanvasPpi: integer;
begin
with ACanvas do
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
GmBrushToBrush(Brush, FBrush);
GmPenToPen(Pen, FPen);
SetLength(CanvasPoints, High(Points)+1);
for count := 0 to High(Points) do
begin
CanvasPoints[count].x := (0-Offset.X) + Round(CanvasPpi * ConvertValue(Points[count].x, GmUnits, GmInches)); //Round(Ppi * InchesX);
CanvasPoints[count].y := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(Points[count].y, GmUnits, GmInches)); // Round(Ppi * InchesY);
end;
Polyline(CanvasPoints);
end;
end;
//------------------------------------------------------------------------------
constructor TGmPolyBezierObject.Create;
begin
inherited;
FShapeID := GM_POLYBEZIER_ID;
end;
procedure TGmPolyBezierObject.Draw(ACanvas: TCanvas; APreview: TComponent; Offset: TPoint; Scale: Extended);
var
count: integer;
CanvasPoints: array of TPoint;
CanvasPpi: integer;
begin
with ACanvas do
begin
CanvasPpi := Round(Scale * PixelsPerInch(ACanvas));
GmBrushToBrush(Brush, FBrush);
GmPenToPen(Pen, FPen);
SetLength(CanvasPoints, High(Points)+1);
for count := 0 to High(Points) do
begin
CanvasPoints[count].x := (0-Offset.X) + Round(CanvasPpi * ConvertValue(Points[count].x, GmUnits, GmInches)); //Round(Ppi * InchesX);
CanvasPoints[count].y := (0-Offset.Y) + Round(CanvasPpi * ConvertValue(Points[count].y, GmUnits, GmInches)); // Round(Ppi * InchesY);
end;
PolyBezier(CanvasPoints);
end;
end;
{$ENDIF}
end.